home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / shells / scsh-0.4 / scsh-0 / scsh-0.4.2 / scsh / meta-arg.scm < prev    next >
Text File  |  1995-10-29  |  5KB  |  135 lines
  1. ;;; Meta-arg argv processor in Scheme.
  2. ;;; Copyright (c) 1995 by Olin Shivers.
  3. ;;;
  4. ;;; This is a Scheme analog of the proc2.c meta-arg expander.
  5.  
  6. ;;; Syntax of the line 2 argument line:
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;; - The only special chars are space, tab, newline, and \.
  9. ;;; - Every space char terminates an argument. 
  10. ;;;   Multiple spaces therefore introduce empty-string arguments.
  11. ;;; - A newline terminates the argument list, and will also terminate a
  12. ;;;   non-empty argument (but a newline following a space does not introduce
  13. ;;;   a final "" argument; it only terminates the argument list).
  14. ;;; - Tab is not allowed.
  15. ;;;   This is to prevent you from being screwed by thinking you had several
  16. ;;;   spaces where you really had a tab, and vice-versa.
  17. ;;; - The only other special character is \, the knock-down character. 
  18. ;;;   \ escapes \, space, tab, and newline, turning off their special 
  19. ;;;   functions. The ANSI C escapes sequences, such as \n and \t are 
  20. ;;;   supported; these also produce argument-constituents -- \n doesn't act 
  21. ;;;   like a terminating newline. \nnn for *exactly* three octal digits reads 
  22. ;;;   as the char whose ASCII code is nnn. It is an error if \ is followed by 
  23. ;;;   just 1 or 2 octal digits: \3Q is an error. Octal-escapes are always 
  24. ;;;   constituent chars. \ followed by other chars is not allowed (so we can
  25. ;;;   extend the escape-code space later if we like).
  26. ;;;
  27. ;;; You have to construct these line-2 arg lines carefully. For example,
  28. ;;; beware of trailing spaces at the end of the line. They'll give you
  29. ;;; extra trailing empty-string args.
  30.  
  31. ;;; (meta-arg-process-arglist args)
  32. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33. ;;; Expand out meta-args in argument lists.
  34. ;;;
  35. ;;; ARGS is an argument list -- a list of strings. If the first two elements
  36. ;;; are of the form ("\\" <filename> ...), then parse secondary arguments
  37. ;;; from line two of file <filename>, change the argument list to
  38. ;;;     (,@<secondary-args> <filename> ...)
  39. ;;; and loop.
  40.  
  41. (define (meta-arg-process-arglist args)
  42.   (let lp ((args args))
  43.     (if (and (pair? args)
  44.          (string=? (car args) "\\"))
  45.     (lp (append (read-files-secondary-args (cadr args))
  46.             (cdr args)))
  47.     args)))
  48.  
  49. ;;; (read-files-secondary-args fname)
  50. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  51. ;;; Open file FNAME, skip the first line, and read secondary args off of
  52. ;;; line two. Return these as a list of strings.
  53.  
  54. (define read-files-secondary-args
  55.   (let ((non-newline (char-set-invert (char-set #\newline))))
  56.     (lambda (fname)
  57.       (call-with-input-file fname
  58.     (lambda (port)
  59.       (skip-char-set non-newline port)    ; Skip the first
  60.       (read-char port)            ; line of text.
  61.       (read-secondary-args port))))))
  62.  
  63.  
  64. ;;; Read in a line of secondary args from PORT.
  65.  
  66. (define (read-secondary-args port)
  67.   (let lp ((args '()))
  68.     (let ((c (peek-char port)))
  69.       (if (or (eof-object? c) (char=? c #\newline))
  70.       (reverse args)
  71.       (lp (cons (read-secondary-arg port) args))))))
  72.  
  73.  
  74. ;;; Read in one secondary arg.
  75.  
  76. (define (read-secondary-arg port)
  77.   (let lp ((chars '()))
  78.     (let ((c (peek-char port)))
  79.       (cond ((or (eof-object? c) (char=? c #\newline))
  80.          (apply string (reverse chars)))
  81.  
  82.         ((char=? c #\space)
  83.          (read-char port)
  84.          (apply string (reverse chars)))
  85.  
  86.         ((char=? c tab)
  87.          (error "Illegal tab character in meta-arg argument line."))
  88.  
  89.         (else (lp (cons ((cond ((char=? c #\\)
  90.                     (read-char port)
  91.                     read-backslash-sequence)
  92.                    (else read-char))
  93.                  port)
  94.                 chars)))))))
  95.  
  96.  
  97. (define (read-backslash-sequence port)
  98.   (let ((c1 (read-char port))
  99.     (eof-lose (lambda () (error "Premature EOF within backslash-sequence in meta-arg argument line"))))
  100.     (cond ((eof-object? c1) (eof-lose))
  101.  
  102.       ;; This would be better handled by a char-map abstraction.
  103.       ((char=? c1 #\n) #\newline)
  104.       ((char=? c1 #\r) carriage-return)
  105.       ((char=? c1 #\t) tab)
  106.       ((char=? c1 #\b) backspace)
  107.       ;; ...whatever. Look up complete table.
  108.  
  109.       ;; \, space, tab, newline.
  110.       ((char-set-contains? char-set:simple-knockdown c1) c1)
  111.  
  112.       ((char-set-contains? char-set:octal-digits c1)
  113.        (let ((c2 (read-char port)))
  114.          (if (eof-object? c2) (eof-lose)
  115.          (let ((c3 (read-char port)))
  116.            (if (eof-object? c3) (eof-lose)
  117.                (ascii->char (+ (octet->int c3)
  118.                        (* 8 (+ (octet->int c2)
  119.                            (* 8 (octet->int c1)))))))))))
  120.            
  121.       
  122.       (else (error "Illegal \\ escape sequence in meta-arg argument line."
  123.                c1)))))
  124.  
  125. (define (octet->int c) (- (char->ascii c) (char->ascii #\0)))
  126.  
  127. (define char-set:octal-digits (char-set #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7))
  128.  
  129. (define char-set:simple-knockdown (string->char-set "\\ \n\t"))
  130.  
  131. ;;; Yechh.
  132. (define tab (ascii->char 9))
  133. (define carriage-return (ascii->char 13))
  134. (define backspace (ascii->char 8))
  135.